perm filename MSS.F4[NEW,LCS]27 blob
sn#395052 filedate 1978-11-13 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00004 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 C ********** DISPLAYS MUSIC AND DRAWS IT ON THE PLOTTER **********
C00029 00003 33 IF(X22.EQ.0)GO TO 6333
C00044 00004 60 J2=R2
C00059 ENDMK
C⊗;
C ********** DISPLAYS MUSIC AND DRAWS IT ON THE PLOTTER **********
C *** READS DATA FROM CLEFA-B-C-ETC., BDR40,BDI40, ETC.
IMPLICIT INTEGER(A-Q,S-Z)
REAL DIS,DISX,A,B,STFF,CENTR,POS ,UD,XDIS
DIMENSION LST(18),DP(0/7)
COMMON /DL/X22,SAVER,NAME,EXT,IOLD /RRJJ/RJJ2,RJJ(20),JJA
1 /FONT/JFONT /RINP/R(10,80),RPOS(2,50),RI(200)
1 /RMOD/RMODE2,RSET4,IBEAM,
1 NOSET,STEM,STUP,NTC,ENDP,RAD,RDD,ITB,POSB
1 /FRMT/F78F(1),FA1(1),FA5(1),ASK /SIZ/RSZ,JCEN,KCEN
C ORDER OF COMMON MUST! REMAIN AS IS (FOR DMP MODE READ)
COMMON /LIMIT/LIMIT,ITEM,L,I,IX,ITEMX,ILIM
1 /STF/RSTFAC(0/7),RSTJ2
1 /POSI/STFF(0/7),JJ2,POS /ALF/INP(72),ML
1 /SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
1 /UPDWN/ RL,UD /IDEV/IDEV /NUM/NUM(10),JRD
1 /PLTR/PLT,RHT,DIS,XDIS /PTR/PWDS(350)
CC COMMON /PLTR/PLT,RHT,DIS,XDIS/PTR/PWDS(250),ITEM,L,I,IX
COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,
1 LMM,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
1 /JCHAR/IXX,ISEMI,IBLA,IG,JED,KED,REDIT,RITEM
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /RNW/RNW /MKS/MKS(14)
1 /XRN/RN(3000) /DPY/ST(4000),MEDIT,IGO /DPTR/WDS(350)
1 /MKX/MKX(11) /SC/SSC(72) /YED/YED,IBOX,RBOX
CC COMMON/XRN/RN(2500)/DPY/ST(4000),WDS(250),MEDIT,IGO
EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),
1 (R6,RJQ(4)),(J10,JQ(8)),(J6,JQ(4)),(R4,RJQ(2)),(R7,RJQ(5))
1,(R3,RJQ(1)),(I2,INP(2)),(I1,INP(1)),(I3,INP(3)),(RJ13,RJJ(11))
1,(R11,RJQ(9)),(NJR,R10,RJQ(8)),(R8,RJQ(6)),(RJ3,RJJ(1)),(R9,
1 RJQ(7)),(RX3,RJQ(20)),(ST2,ST(2)),(R13,RJQ(11)),(J8,JQ(6))
1 ,(J13,JQ(11)),(IPOS,POS),(LST(13),K),(LST(14),X),(LST(15),J)
1 ,(I7,INP(7)),(IM,MKS(5)),(IP,MKS(11)),(IR,MKS(13)),(IU,MKS(8)),
1 (IC,MKS(12)),(IA,MKS(2)),(IFF,MKS(3)),(IT,MKS(6)),(IOO,MKS(14)),
1 (IS,MKS(4)),(ID,MKS(7)),(II,MKS(10)),(IW,MKS(1)),(IH,MKS(9))
1 ,(MINUS,MKX(10)),(LESS,MKX(3)),(IGT,MKX(4)),(RJ7,RJJ(5))
DATA NUM/'0','1','2','3','4','5','6','7','8','9'/,JRD/0/,ILIM/350/
1 ,STFF/-469.,-346.,-223.,-100.,23.,146.,269.,392./,RSTFAC/8*1./
1 ,LST/'NOTE','REST','CLEF','LINE','SLUR','BEAM','TRILL','STAFF',
1 'MISC','NUMB','LIBRY','CIRCL',0,0,0,'WORD','KSIG','METER'/,
1DP/8*1/,IE/'E'/,IJ/'J'/,RNW/2.44/,IL/'L'/,INN/'N'/,LCNT/1/,LIMIT
1/3000/,IQ/'Q'/,IZ/'Z'/,IB/'B'/, DIS/1.0/, RHT/1.0/,EXT/'DMD'/
DATA MKS/'W','A','F','S','M','T','D','U','H','I','P','C','R','O'/
C THE GIANT NUMBERS ARE FOR [ AND ]
DATA MKX/'/',';','<','>',-19728949184,-18655207360,'(',')','.'
1,'-','*'/,SSC(14)/'X'/,SSC(15)/';'/,SSC(72)/' '/
C LIMIT IS MAIN ARRAY LENGTH (3000)
C 350 LIM. ON ITEMS PWDS, WDS (SEE ALSO 571 TO 170)
C***** CALL SEGFIX
C FOR UPPER SEGMENTS USED BY MORE THAN 1 JOB (SEGFIX.FAI[TVR])
LCEN=0
MCEN=0
IDEV=5
I1=0
2 CALL DPYSET(1,ST,4000)
CALL HYDPOG(2)
CALL HYDPOG(1)
CALL TYPLOC(450,0)
CALL DPYBRT(5)
DO 299 K=1,I
CLEARS ARRAY FOR RESTART OF 'SETUP' ROUTINE
299 RN(K)=0
JFONT=0
CHNG=0
C flag for edit changes (=-1 means a change has been made.)
IOLD=0
C IOLD HOLDS LAST ITEM NUM. EDITED.
IX=0
RSET4=999
QUICK=0
CB=0
C CB IS CENTER-BIG (CENTERING RANGE=6)
UD=1
RL=1
FSCN=LEL
RPOS(1,1)=0
RSZ=.845
X22=0
JCEN=0
KCEN=0
PLT=0
PWDS(1)=1
EDQ=-1
RN(2)=0
C FOR RESTART. AVOIDS STAFF CODE NUM.
SAVER=4
DO 1402 K=0,7
1402 RSTFAC(K)=1.
REDIT=999.
M=1
ITEM=0
ITEMX=0
ZERO=-1
WDS(1)=4
C DATA IN DPY ARRAY STARTS AT WD.4!
I=1
1100 SCORE=-1
58 IGO=-1
IF(I1.NE.IR)GO TO 5505
I1=-1
CALL NAMEXT(INP,NAME,EXT)
J2=0
IF(NAME.NE.IBLA)GO TO 1221
C YOU CAN TYPE 'RS NAME' FOR QUICK RESTARTS
GO TO 5505
11 CALL NOTWRT
57 IF(M.GT.I)GO TO 571
IF(IGO)CALL DPYOUT(1)
571 ITEM=ITEM+1
IF(ITEM.LT.ILIM)GO TO 17
CALL TYPSTR('**** TOO MANY ITEMS')
CALL TYPINT(ITEM)
CALL TYPSTR('/349')
CALL TYPCRLF
CCCC TYPE 170,ITEM
I=PWDS(ILIM)
ITEM=ILIM-1
ST2=WDS(ILIM)
CALL DPYOUT(1)
GO TO 1100
CCC170 FORMAT(2(' **** TOO MANY ITEMS ',I3,'/299'/))
17 IF(IGO.GT.0)GO TO 20000
K=ST2
IF(X22.EQ.0)GO TO 20000
CALL BOX(IBOX,RBOX)
ST2=K
20000 WDS(ITEM+1)=ST2
IF(EDQ.EQ.-1)GO TO 1571
IF(M.LT.I)GO TO 6120
C SL=SAVE AFTER RESETTING LENGTH OF PAGE. (SEE I2 IN SCX)
1571 PWDS(ITEM+1)=I
PLT=0
IF(IGO.NE.0)GO TO 55
CALL DPYOUT(1)
IF(SCORE.EQ.0)GO TO 9532
C GO GET MORE FROM SCX.
IGO=-1
55 IF(SCORE.EQ.0)GO TO 653
5505 SVST=ST2
C CATCHES TYPO WITH 'C'
K=ITEM+1
IF(X22.EQ.0)GO TO 5503
C 'N' SUPPRESSES TYPE-OUT, 'P' OR NEW ITEM RESTORES IT.
IF(QUICK)5911,210,10
C -1=QUICK MODE, +1=SUPPRESS TYPE-OUT OF PARAMS
210 L=RN(MEDIT+1)
K=X22
IF(IDEV.EQ.1)GO TO 5503
C 'FILE'CAN BE USED WHILE IN EDIT MODE
CC IF(L.EQ.11.OR.L.EQ.12)L=9
CC IF(L.EQ.13)L=11
CC IF(L.GE.15)L=L-5
CCCC TYPE 427,LST(L),(RN(L),L=MEDIT+1,MEDIT+3)
CALL TYPCRLF
CALL TYPWRD(LST(L))
CALL TYPCRLF
CALL TYPFLT(RN(MEDIT+1))
CALL TYPCHR(' ',3)
CALL TYPFLT(RN(MEDIT+2))
CALL TYPCHR(' ',3)
CALL TYPFLT(RN(MEDIT+3))
CCCCC TYPE 1427,(RN(L),L=MEDIT+1,MEDIT+3)
IF(YED.LT.2)GO TO 59
C YED IS SET AT 426
DO 5501 L=4,YED+2
CALL TYPCHR(' (',4)
CALL TYPINT(L)
CALL TYPCHR(') ',2)
5501 CALL TYPFLT(RN(MEDIT+L))
CALL TYPCRLF
CCC5501 TYPE 4271,L,RN(MEDIT+L)
GO TO 59
CCCC5919 FORMAT(' ;=LFT :=RT (=UP )=DN /=HALF *=*2'/)
591 IF(X22.EQ.0)GO TO 59
QUICK=-1
CALL TYPSTR(';=LFT :=RT (=UP )=DN /=HALF *=*2')
CALL TYPCRLF
CCCC TYPE 5919
5911 CALL FSCAN
C FNUM.FAI=FAST COMMANDS ;=← :=→ (=↑ )=↓ /=HALF *=*2 X=X C=C OTHERS=CR
GO TO 1591
GO TO 2591
GO TO 3591
GO TO 4591
GO TO 5913
GO TO 6591
GO TO 7591
GO TO 5912
I1=0
5591 QUICK=0
GO TO 5917
1502 FORMAT(2A5)
502 REREAD 1502,K,K
CALL LO2UP(K)
C CHANGES LOWER CASE TO UPPER CASE
IF(LOOK(K)+LOOKD(K))GO TO 2502
CALL TYPSTR(' FILE NOT FOUND')
GO TO 59
2502 CALL IFILE(1,K)
2503 IDEV=1
GO TO 10
CC IF(I1.NE.LOH)GO TO 10
3502 IDEV=5
GO TO 59
C RESET TO TTY MODE
5503 CALL HYDPOG(3)
C TO DELETE VERTICAL LINE (55)
KED=0
QUICK=0
C RESET PARAM TYPE-OUT
RJ13=0
C KILL CENTERING FEATURE FOR NOW
CC** NEXT DOES THIS FASTER*** 59 TYPE 56,NAME,K,I,SVST
59 IF(IDEV.EQ.1)GO TO 10
CALL TYPCRLF
IF(X22.EQ.0)GO TO 1101
CALL TYPSTR('**** EDIT ITEM #')
CALL TYPINT(K)
GO TO 2101
1101 CALL TYPWRD(NAME)
CALL TYPSTR(' TYPE FOR ITEM #')
CALL TYPINT(K)
CALL TYPSTR(' ')
CALL TYPINT(I)
CALL TYPSTR(' ')
CALL TYPINT(SVST)
2101 CALL TYPCRLF
10 SCORE=-1
CQQ ACCEPT 89,INP
READ(IDEV,89,END=3502)INP
CALL LULOOP
IF(I1.EQ.LESS)GO TO 3502
C '<' = TEMPORARY ESCAPE FROM 'FILE' MODE
IF(I1.NE.IGT)GO TO 1000
IF(X22.NE.0)GO TO 59
C '>' = RETURN TO 'FILE' MODE - IF NOT STILL EDITING.
GO TO 2503
1000 IF(IDEV.EQ.5)GO TO 4502
IF(I7.NE.IT)GO TO 4502
IF(I1.NE.LCC)GO TO 4502
C 'ET' DIRECTORY? UGH!!!
6502 READ(IDEV,89)INP
IF(I3.NE.ISEMI)GO TO 6502
READ(IDEV,89)INP
C READ AGAIN TO GET PAGE MARK - OR SOMETHING???
GO TO 10
4502 REREAD 1,J,R2,RJQ
C ↑↑↑ 1/78
C ↓↓↓↓ FIRST CATCHES BLANKS, NUMBERS, ETC.
5917 IF(I1.GE.MINUS)GO TO 110
IF(I1.EQ.IBLA)GO TO 110
IF(I1.EQ.II)GO TO 678
C IN, ITEM
IF(I1.EQ.IXX)GO TO 78
C X=EXIT
IF(I1.EQ.LEL)GO TO 778
C L=LEFT, LP=LIGHT PEN
IF(I1.EQ.IU)GO TO 883
C UP
IF(I1.EQ.IR)GO TO 8835
C R=RIGHT, RI=RIT, READ, RS=RESTART
IF(I1.EQ.LDD)GO TO 478
C D=DOWN, DI=DIM, DE=DELETE
IF(I1.EQ.LCC)GO TO 178
C C=COPY, CR=CRESC., CN=CENTER, CB=CENTER BIG, CH=ON HEAD, CT=ON TAIL
IF(I1.EQ.IS)GO TO 15
C SAVE, SPACING STAFF, STAFF, SHOW, SF, SFZ, SCALE, STC=STACCATO
IF(I1.EQ.LEE)GO TO 878
C ED=EDIT WITH POS. FIRST, E=EDIT WITH LIGHT PEN, ES=EDIT WITH STAFF NUM. FIRST
IF(I1.EQ.INN)GO TO 410
C N=NO TYPE
IF(I1.EQ.IP)GO TO 33
C P,PP,PPP, P N=PRINT PARAM N., PR=PRINT PARAM LIST, POCO, PIU, PZ=PIZZ,PL=PLUS
IF(I1.EQ.LAA)GO TO 378
C A=ADJUST TO SET, AD=ADJUST STEMS, AC=ACCEL, AR=ARCO, AT=A TEMPO, ACT=ACCENT
IF(I1.EQ.IQ)GO TO 591
C Q=QUICK
IF(I1.EQ.IT)GO TO 441
C T=TYPE TEXT, T=TYPE OUT, TE=TENUTO, TL=TYPLOC
IF(I1.EQ.LFF)GO TO 2442
C F,FF,FFF,FE=FERMATA,FILE(TO READ COMMAND FILE)
IF(X22.NE.0)GO TO 59
C NEXT CANNOT HAPPEN IN EDIT MODE.
IF(I1.EQ.IZ)GO TO 24
C ZOOM
IF(I1.EQ.IM)GO TO 7555
C M=MOVE, ME=MENO, MO=MOLTO, MF,MP
IF(I1.EQ.IJ)GO TO 7555
C JUSTIFY
IF(I1.EQ.LGG)GO TO 120
C GET, GM=GET MORE
IF(I1.EQ.LHH)GO TO 1678
C H=HARMONIC, HW=HEAVY WEDGE
IF(I1.EQ.IW)GO TO 1778
C W=WEDGE ACCENT
IF(I1.EQ.'(')GO TO 7378
IF(I1.EQ.')')GO TO 7478
IF(I1.EQ.',')GO TO 7778
C LEFT AND RIGHT PARENTHESES AND COMMA
IF(I1.NE.LBB)GO TO 59
C******* ADD MORE LETTER ITEMS HERE *************
C BRC=BRACE, BRK=BRACKET -- FOR FRONT OF LINE. BAR=BAR LINE.
IF(X22.NE.0)GO TO 59
REREAD 1,JA,JA,JA,R2,RJQ
J=4
R7=5
IF(I3.NE.LCC)R7=4
IF(I3.EQ.IR)R7=0
GO TO 110
378 IF(I2.EQ.LDD)GO TO 887
C 'A' = ALTER(GO TO 112) ADJUST(GO TO 886) ACCEL(GO TO 7813)
C ALIGN=GO TO 886
IF(X22.NE.0)GO TO 886
IF(I2.EQ.IT)GO TO 7178
C AT=A TEMPO
IF(I2.EQ.IR)GO TO 7278
C AR=ARCO
IF(I2.NE.LCC)GO TO 112
IF(I3.EQ.IT)GO TO 1278
C ACT=ACCENT. NEXT FOR AC (=ACCEL.)
RD=80
GO TO 1442
478 IF(I2.GE.IBLA)GO TO 883
C 'D' DIM →578, DOWN →883, DELETE →112 OR 883 DP →886
IF(I2.NE.LEE)GO TO 578
IF(X22.NE.0)GO TO 883
GO TO 112
578 IF(I2.EQ.IP)GO TO 887
IF(I2.NE.II)GO TO 59
C NEXT FOR DIM.=82
IF(X22.NE.0)GO TO 59
RD=82
GO TO 1442
1591 I1=LEL
9591 FSCN=I1
GO TO 5917
2591 I1=IR
GO TO 9591
3591 I1=IU
GO TO 9591
4591 I1=LDD
GO TO 9591
7591 I1=IXX
GO TO 5591
5912 I1=LCC
GO TO 5591
5913 I1=FSCN
IF(FSCN.EQ.LEL)GO TO 5914
IF(FSCN.EQ.IR)GO TO 5914
C NEXT FOR UP-DOWN
UD=UD/2
GO TO 5917
5914 RL=RL/2
GO TO 5917
6591 I1=FSCN
IF(I1.EQ.LEL)GO TO 5916
IF(I1.EQ.IR)GO TO 5916
UD=UD*2
GO TO 5917
5916 RL=RL*2
GO TO 5917
C 'S'=SET, SA=SAVE, SB=SAVE BIG, SM=BIG+SAME NAME, ST=STAFF, SP=SPC STF.
C SC=SPACING SCALE ABOVE STAFF n (99=DELETE IT)
15 IF(I2.EQ.IT)GO TO 885
IF(I2.EQ.LAA)GO TO 3121
IF(I2.EQ.LCC)GO TO 886
IF(I2.EQ.LDD)GO TO 3121
IF(I2.EQ.LEE)GO TO 312
IF(I2.EQ.IBLA)GO TO 312
IF(I2.EQ.IP)GO TO 87
IF(I2.EQ.LHH)JFONT=1
IF(I3.EQ.IXX)JFONT=0
IF(I3.EQ.IP)JFONT=-1
IF(I3.EQ.LOH)JFONT=-2
IF(I3.EQ.II)JFONT=-3
C 'SH'(=SHOW) IS SAME AS 44 1. SHOWS TYPE FONTS ON DPY.
C 'SHP' = SHOW ONLY AS 'PRIMITIVE' FONT, 'SHX' = CANCEL FONTS ON DPY.
C 'SHO' = FONT SET (TEMPORARILY) TO 'BDR'; 'SHI' = 'BDI' (ITALICS)
IF(I2.NE.LFF)GO TO 3122
RD=45
IF(I3.NE.IZ)GO TO 1442
RD=92
3123 REREAD 1,JA,JA,JA,R2,RJQ
R5=RD
GO TO 442
3122 IF(I2.NE.IM)GO TO 5505
C ONLY FOR ST, SA, SB, SM, RS, S, SF=45, SFZ=92
3121 IF(X22.NE.0)GO TO 5505
SAVER=4
CALL SAVIT
GO TO 5505
312 JA=55
R2=RN(MEDIT+3)
C POSITION OF ITEM LOOKED AT.
R3=55.
GO TO 6531
C ABOVE FOR 'S'ET ALIGNMENT
C 'S'=SET ALIGNMENT, 'A'=ALIGN IT. 'M'=MOVER 'C'= COPIER
C 'E'=EDIT; 'I'=ITEM; 'G'=GET; 'GM'=GET MORE;
878 K=-1
DO 882 JA=3,10
882 IF(INP(JA).NE.IBLA)GO TO 887
GO TO 883
885 FORMAT(A2,21F)
CC IF(X22.NE.0)GO TO 59
IF(I3.EQ.LCC)GO TO 1578
C STC=STACCATO
887 IF(CHNG.NE.0)GO TO 5505
C CAN'T DO 'ST' AND OTHER THINGS AFTER CHANGES IN EDIT MODE.
886 REREAD 885,K,R2,RJQ
JA=55
IF(I2.NE.LCC)GO TO 101
CALL SCL
GO TO 5505
101 IF(I2.NE.LDD)GO TO 988
IF(I1.EQ.LAA)JA=19
C 'AD'just stems to beams.
988 IF(I2.EQ.IT)JA=44
IF(I2.EQ.INN)GO TO 188
IF(I2.NE.IP)GO TO 6531
IF(R2.GT.7)GO TO 1886
C GO BACK AND RESET ALL IF STF NUM >7
K=R2
JA=0
C USE '8' FOR STAFF 0.
888 IF(K.EQ.8)K=0
DP(K)=-DP(K)
JA=JA+1
K=RJQ(JA)
IF(K.EQ.0)GO TO 55
C JUMP OUT IF RJQ(JA)=0 OR 99
IF(K.EQ.99)GO TO 85
C*** 3/74 END WITH '99' TO MAKE DP RIGHT NOW!
GO TO 888
1886 DO 2886 K=0,7
2886 DP(K)=1
GO TO 85
C TO GET BACK OTHERS - 'DPY N' AGAIN WILL DO.
778 IF(I2.NE.IP)GO TO 883
C 'LP'=LIGHT PEN. TO BE USED ONLY IN EDIT MODE
78 IF(X22.EQ.0)GO TO 59
C 'X' GO BACK IF NOT IN EDIT MODE
C NEXT FOR READ, RS, DEL, L,R,U,D
883 IF(IX.EQ.I)GO TO 8834
C CAN'T DELETE ('DE') AFTER A PARAM HAS BEEN CHANGED. START OVER.
IF(I2.NE.LEE)GO TO 8831
GO TO 5505
8835 IF(I2.GE.IBLA)GO TO 8831
C R=RIGHT MOVE, RI=RIT., RS=RESTART, READ=READ
IF(X22.NE.0)GO TO 59
C GO BACK IF STILL IN EDIT MODE.
IF(I2.EQ.IS)GO TO 2
C TYPE 'RS' TO RESTART.
IF(I2.NE.II)GO TO 8830
C NEXT FOR RIT.=37
RD=37
GO TO 1442
8830 JA=144
C 'READ' IS SAME AS 144
GO TO 88
8834 IF(I1.EQ.LCC)GO TO 72
8831 IF(JA.NE.16)GO TO 8832
IF(X22.EQ.0)GO TO 5505
C CAN'T MOVE LETTERS OR 'SCORE' ENTRIES UNLESS REALLY IN EDIT MODE!
8832 CALL EDIT(JJA)
IF(JA.NE.99)GO TO 6531
CALL DELETE
C DELETE ROUTINE COULD BE PUT DIRECTLY IN HERE.
GO TO 425
89 FORMAT(72A1)
C TYPE L, R, U OR D OR EDIT TO MOVE LAST ENTERED ITEM.
410 IF(QUICK.NE.0)GO TO 510
C ↑↑↑ SO 'N n' WILL WORK EVEN AFTER N HAS BEEN SET.
QUICK=1
C TYPE 'N' =NO-TYPE PARAMS TO SUPPRESS TYPE-OUT WHILE EDITING.
IF(X22.NE.0)GO TO 87
510 I1=II
C 'N n' WHEN NOT IN EDIT MODE = 'I n'<CR>,'N'<CR>
87 IF(I1.NE.II)GO TO 610
678 IF(I2.EQ.INN)GO TO 887
C 'IN n,n,n,' MUST BE READ AGAIN AT 886 TO GET n'S CORRECTLY.
JA=22
IF(CHNG.NE.0)GO TO 5505
C AFTER A CHANGE OF AN ITEM, 'I', ETC. IS ILLEGAL.
GO TO 6531
610 IF(K)JA=55
C ED 47 -1 = 55 47 -1, ETC.
IF(JA.EQ.101)GO TO 101
IF(I1.NE.INN)GO TO 710
IF(R2.NE.0)GO TO 510
C IF NO NUM FOLLOWS 'N' GO PRINT OUT CURRENT PARAMS.
GO TO 10
C 'Z' = ZOOM (OLD CODE# 24)
710 IF(I2.NE.IP)GO TO 441
RSET4=R3
C SPn SETS "SETUP" STAFF NUMBER
GO TO 5505
C 'SP' IS SAME AS 444
C 'P n' = PRINT CURRENT CONTENTS OF PARAM n. (ONLY WHILE IN EDIT MODE.)
441 IF(X22.EQ.0.OR.I2.EQ.LEL)GO TO 288
C JUMP OUT IF 'TL' (TYPLOC)
QUICK=0
C TYPE 'T' TO RESET PARAM TYPE-OUT
IF(R2.EQ.0)GO TO 5505
GO TO 510
1078 RD=14
C PLUS
1178 REREAD 885,JA,R2,RJQ
1378 IF(X22.NE.0)GO TO 5505
C CAN'T ENTER NEW ITEM WHILE IN EDIT MODE.
J=9
R5=RD
IF(R4.EQ.0)R4=15
GO TO 110
1278 RD=5
C ACCENT
1478 REREAD 1,J,J,J,R2,RJQ
GO TO 1378
1578 RD=7
C STACC.
GO TO 1478
1678 RD=13
C HARMONIC
IF(I2.EQ.IW)RD=21
C HEAVY WEDGE
GO TO 1178
1778 RD=4
C WEDGE
GO TO 1178
3442 REREAD 885,JA,R2,RJQ
R5=26
J=9
IF(R4.EQ.0)R4=12
C FERMATA
GO TO 110
2442 IF(I2.EQ.II)GO TO 502
IF(X22.NE.0)GO TO 59
R5=51
C F=51 FF=52 FFF=53, FE=FERMATA, FILE
IF(I2.EQ.IBLA)GO TO 442
IF(I2.EQ.LEE)GO TO 3442
RD=53
IF(I3.NE.IBLA)GO TO 3123
RD=52
1442 REREAD 885,JA,R2,RJQ
R5=RD
442 J=3
IF(R4.EQ.0)R4=-5
C ABOVE IS FOR DIRECT TYPING OF P,PP,PPP,MP,RIT., ETC.
C IF PARAM 4 IS 0, PUTS IT -5 BELOW.
110 JA=J
IF(JA.GT.0)SAVER=SAVER-1
IF(X22.NE.0)GO TO 6531
IF(SAVER)CALL SAVIT
C SAVES EVERY 4TH TIME AROUND
IOLD=0
C RESET FLAG FOR "I" COMMAND
IF(JA.EQ.0)GO TO 5505
C CATCHES ZEROS
GO TO 6531
C NEXT FOR ALPHA TEXT ITEMS. 'T'=TYPE
288 IF(I2.NE.LEE)GO TO 388
RD=9
C TENUTO
GO TO 1178
388 IF(I2.NE.LEL)GO TO 488
J3=R3
J4=R4
C 'TL' SET LOCATION OF TYPE OUT ON SCREEN
IF(J4.EQ.0)J4=J3-200
C OMIT 2ND NUM. AND GET N AND N-200.
IF(R3.NE.0)GO TO 588
IF(R4.NE.0)GO TO 588
J4=0
J3=450
C 'TL' 0 0 PUTS IT BACK TO ORIG. LOC.
588 CALL TYPLOC(J3,J4)
GO TO 5505
488 JA=16
C 'T' = TEST INPUT
J2=R2
M=I
CALL WORDS
SAVER=SAVER-1
IOLD=0
GO TO 8852
188 IF(X22.NE.0)GO TO 5505
JA=14
RMODE2=R3
C TYPE 'IN STF# MODE' ETC. -- SAME AS 14 STF#.
88 SCORE=0
IF(JA.NE.14)GO TO 889
C NEXT PUTS UP STAFF IF IT WASN'T THERE ALREADY
SAVER=-1
RSTF=R2
IF(R3)R3=0
DO 1889 K=1,ITEM
J=PWDS(K)
IF(RN(J+1).NE.8)GO TO 1889
IF(RN(J+2).EQ.R2)GO TO 890
1889 CONTINUE
C DIDN'T FIND THIS STAFF
M=LIMIT
C ↑↑ WAS =2000 6/78
IGO=0
JA=8
R3=0
GO TO 6531
890 JA=14
ITCHK=ITEM
ICHK=I
IDPY=ST2
C ALL THIS FOR BACKUPS
889 SPD=ST2
JIT=ITEM
ISC=I
REND=0
C RETAINS ORIGINS OF SCORE SQUENCE
9532 IF(REND.EQ.2)GO TO 889
C FOR READIN CONTINUATION.
M=ISC
9533 IF(JA.EQ.8)GO TO 890
IF(REND)GO TO 9535
C REND=0 GO, -1=NORMAL END, 1=ABORTED.
CALL SCMSS
IOLD=0
IF(REND.EQ.1)GO TO 9535
IF(REND.NE.99)GO TO 9534
I=ICHK
ITEM=ITCHK
ST2=IDPY
CALL ACCPOG(1)
CALL DPYOUT(1)
GO TO 9535
9534 ITEM=JIT
J=M
9536 ITEM=ITEM+1
PWDS(ITEM)=J
J=J+RN(J)+3
IF(J.LT.I)GO TO 9536
IF(IBEAM)GO TO 9537
R13=0
R2=RSTF
JA=19
J3=0
CALL HOMER
9537 ITEM=JIT
ST2=SPD
GO TO 8852
9535 SCORE=-1
CALL SHRINK(JIT)
C GETS RID OF ZEROS AT END OF NOTE PARAM LIST.
IGO=-1
JA=16
C FOR TRAP AT 'EDIT'
GO TO 5505
112 IGO=1
CALL GRED
JFONT=0
IF(JA.EQ.98)GO TO 5533
KNT=0
SCORE=0
653 KNT=KNT+1
C NUM OF ITEMS IN LIST
R11=0
R10=0
R9=0
JA=R(1,KNT)
R2=R(2,KNT)
IF(JA.NE.0)GO TO 550
C =0 MEANS NO MORE ITEMS.
CALL DPYOUT(1)
GO TO 1100
5533 X22=0
IGO=-1
CALL DPYNEW
GO TO 55
550 DO 7531 K=1,6
7531 RJQ(K)=R(K+2,KNT)
6531 M=1
EDQ=-1
IF(JA.EQ.222)GO TO 72
IF(JA.EQ.2222)GO TO 73
DO 5532 K=1,20
5532 JQ(K)=RJQ(K)
C X22= ITEM# WHEN EDITING OR DELETING.
IF(X22.NE.0)GO TO 5511
IF(JA.GT.0)GO TO 155
IF(R2.EQ.0)GO TO 5505
C FOR UP, DOWN, LEFT, RIGHT
RJJ2=J2
GO TO 6221
C GOES BACK IF NEGATIVE AND NOT IN EDIT MODE.
155 IF(JA.EQ.22)GO TO 42
IF(JA.EQ.44)GO TO 44
C THIS '44' IS SET IN 'EDIT' - IT'S NEVER TYPED.
IF(JA.EQ.55)GO TO 554
IF(JA.NE.19)GO TO 60
271 CALL HOMER
GO TO 8853
33 IF(X22.EQ.0)GO TO 6333
C WHEN NOT IN EDIT MODE(X22=0) "P n n2" LISTS ALL PARAMS FOR ITEMS n→n2.
J2=R2
TYPE 331,J2,RJJ(J2-2)
C TYPE P n TO SEE FULL CONTENTS OF PARAM. n.
GO TO 5505
331 FORMAT(I,F15.5)
24 IF(X22.NE.0)GO TO 59
C 'Z' = ZOOM CAN'T DO ZOOM WHILE IN EDIT MODE
JA=24
IGO=0
23 IF(R2.LT.200)GO TO 123
R3=AMOD(R2,100.)
R2=(R2-R3)/100.
R4=R2*6-R2
C TYPE 24 200.5 FOR 1ST HALF OF DOUBLE, 301 FOR LAST THIRD OF TRIPLE, ETC.
123 IF(I2.GT.0)GO TO 2410
CC IF(R3.EQ.0)GO TO 2410
C NEXT SECTION FOR ZLn, ZRn, ZUn, ZDn. n=% OF SCREEN CHANGE OF CENTER POINT.
REREAD 885,R3,R3
C FOR SOME REASON ONLY 'ZD' NEEDS THIS REREAD?!?!?!? FORMAT(A2,21F)
IF(R3.EQ.0)R3=RZZZ
RZZZ=R3
C SAVE R3 FOR REPEAT OF COMMAND WITHOUT n.
R3=R3/RZMSZ
C 'ZR10' MEANS MOVE CENTER OF IMAGE 10% OF SCREEN SIZE TO RIGHT.
IF(I2.NE.IR)GO TO 1230
R3=-R3
1231 R3=RZMX+R3
R4=RZMY
1232 R2=RZMSZ
GO TO 1245
1230 IF(I2.EQ.IL)GO TO 1231
IF(I2.NE.IU)GO TO 1233
R3=-R3
1234 R4=RZMY+R3
R3=RZMX
GO TO 1232
1233 IF(I2.EQ.ID)GO TO 1234
2410 IF(R2.NE.0)GO TO 241
IF(I2.EQ.LZZ)GO TO 245
IGO=-1
243 R2=1.
C TO REDISPLAY WITH MAGNIFICATION - OR JUST RUN THROUGH DATA.
241 IF(R2.LE.1)GO TO 1245
IF(R3.NE.0)GO TO 1245
245 CALL ZCRSOR
C 'Zn' (AND NO OTHER NUM) WHERE n >1 ALLOWS YOU SET CENTER WITH LIGHTPEN.
1245 RSZ=.845*R2
RZMSZ=R2
RZMX=R3
RZMY=R4
C REMEMBER FACTORS
JCEN=0
KCEN=0
IF(R2.EQ.1)GO TO 3312
IF(R2.LT.1)GO TO 240
JCEN=(R3*10-500)*RSZ
KCEN=(R4*10-480)*RSZ
C NEXT TO RECONSTITUTE SPACING SCALE.
CC IF(R2.GT.1)GO TO 240
CC JCEN=0
CC KCEN=0
CC IF(R2.EQ.1)GO TO 3312
240 R2=(R4-100.)/100.
C%%%%%%%%%%%%%
IF(R2.LT.0)R2=0
C WE DON'T WORRY IF IT'S TOO HIGH (YET).
3312 R4=0
R2=R2+1
CALL SCL
R2=0
R3=0
R4=0
LCEN=0
MCEN=0
C IF P5 ≠ 0 GOES THROUGH DATA IN OLD WAY.
JFONT=0
85 M=1
I=PWDS(ITEM+1)
ITEMX=ITEM
C FOR USE IN CENTERING WHOLE RESTS (IN NOTWRT [NTSM.FAI])
ITEM=0
8552 ST2=3
8852 PLT=1
EDQ=0
CALL ACCPOG(1)
IF(JA.EQ.0)GO TO 6120
IF(JA.NE.24)IGO=0
GO TO 6120
6333 IF(I2.EQ.IR)GO TO 6334
C NOW TYPE 'PR' TO PRINT PARAMETER LIST
R5=42
IF(I2.EQ.IBLA)GO TO 442
IF(I2.EQ.IP)RD=41
C PPP=40 PP=41 P=42 POCO=72 PIU=91
IF(I2.EQ.II)RD=91
IF(I2.EQ.LOH)RD=72
IF(I2.EQ.LEL)GO TO 1078
C PLUS
IF(I2.EQ.IZ)GO TO 7078
C PIZZ
IF(I3.EQ.IBLA)GO TO 1442
RD=40
GO TO 3123
6334 CALL LISTP(LST)
GO TO 5505
7078 RA=51857895.
RB=95389999.
C PIZZ.
7578 RD=0
7978 RE=1
7878 J=16
REREAD 885,JA,R2,RJQ
R6=RA
R7=RB
R8=RD
IF(R5.EQ.0)R5= RE
IF(R4.EQ.0)R4=14
C 0=PUT IT ABOVE STAFF
GO TO 110
7178 RA=51704789.
RB=74828584.
RD=99999999.
C A TEMPO
GO TO 7978
7278 RA=51708772.
RB=84999999.
C ARCO
GO TO 7578
7378 RA=40999999.
7678 RB=0
GO TO 7578
C LEFT AND RIGHT PARENTHESES AND COMMA
7478 RA=41999999.
GO TO 7678
7778 RA=36999999.
RB=0
RD=0
RE=1.5
C COMMA IS DEFAULT SIZE 1.5
GO TO 7878
172 CALL JUGGLE
CALL CLRCUR
CALL DPYNEW
CHNG=0
C RESET CHANGE FLAG - CLEAR EDIT MODE ERROR TRAP
IF(JA.EQ.22)GO TO 424
C FOR MOVING DIRECTLY TO NEW ITEM IN EDIT MODE.
IF(ZERO)GO TO 55
X22=ZERO
ZERO=-1
IF(JA.EQ.55)GO TO 554
IF(JA.EQ.44)GO TO 44
IF(KED.NE.0)GO TO 244
GO TO 425
C 55,POS -- SETS UP ALIGNMENT
554 IF(I2.NE.IS)GO TO 2554
CALL EXCH(R2,R3)
J3=R3
C 'ES' IS "EDIT, STAFF, POS., CODE"
C 'ED' IS "EDIT, POS., STAFF, CODE"
2554 CALL BOX(-1,R2)
IF(J4.EQ.0)KED=-1
RITEM=R4
C FOR 'ED POS., STF., CODE#' (STF > 7 = ALL STAVES)
IF(J3.GT.7)KED=-2
RLINE=R2
R2=R3
GO TO 45
C '22,0' EDITS LAST ITEM ENTERED
42 REDIT=999.0
IF(R2.NE.0)GO TO 242
X22=ITEM
IF(IOLD.EQ.0)GO TO 429
IF(IOLD.LE.ITEM)X22=IOLD
GO TO 429
44 KED=1
RITEM=R3
C 'ST*, STF#, CODE# (IF 0, ALL ITEMS COME UP) - STF>7 = ALL STAVES.
IF(R2.GT.7)KED=2
45 REDIT=R2
C THE STAFF #
JED=1
244 IF(EDX(RLINE).GE.0)GO TO 73
CC244 X=ITEM
CC IF(JED.GT.X)GO TO 444
CC DO 144 K=JED,X
CC L=PWDS(K)
CC IF(KED.EQ.-2)GO TO 654
C -2 LOOKS AT ALL ITEMS NEAR VERT. LINE, -1 ON SINGLE STAFF.
CC IF(KED.EQ.2)GO TO 656
CC IF(RN(L+2).NE.REDIT)GO TO 144
CC IF(KED)GO TO 654
CC IF(RITEM.EQ.0)GO TO 655
CC656 IF(RITEM.NE.RN(L+1))GO TO 144
CC655 IF(JA.NE.55)GO TO 344
CC654 IF(ABS(RLINE-RN(L+3)).LT.5.0)GO TO 344
CC144 CONTINUE
CC444 REDIT=999.
C NO MORE ON LINE
CC R2=0
C SO IT WILL RETURN IF NOTHING IS FOUND WITH 'ED' OR 'ST'.
CC GO TO 73
CC344 JED=K+1
C FOR NEXT TIME AROUND
CC X22=K
GO TO 429
C CR MOVES ALONG GIVEN LINE, 222 LEAVES THIS MODE
91 CALL ACCPOG(1)
IF(I.EQ.IX)ITEM=ITEM-1
GO TO 142
242 IF(X22.GT.0)GO TO 5511
142 IF(R2.NE.0)GO TO 424
IF(REDIT.EQ.999)GO TO 1554
IF(JA.GE.0)GO TO 244
1554 X22=X22+1
IF(JA)X22=X22-1+JA
IF(X22.LT.1)X22=1
GO TO 425
CCC427 FORMAT(1XA5/,2F6.0,F10.2,$)
CC1427 FORMAT(/,2F6.0,F10.2,$)
CCC4271 FORMAT('+ (',I2,')',F7.2,$)
C FOR EDITING
5511 IF(JA.EQ.55)GO TO 420
220 IF(JA.NE.22)GO TO 720
C 'I, #' WILL MOVE TO ANOTHER ITEM WHEN ALREADY IN EDIT MODE.
KED=0
JED=0
GO TO 72
720 IF(JA.EQ.44)GO TO 420
C FOR '24' WHILE IN EDIT MODE. MAGS WITH CURSOR AS CENTER.
IF(JA.GT.100)GO TO 4221
IF(JA.GT.13)GO TO 5505
C PARAM NUM TOO HIGH? LOOKS FOR NEXT ITEM TO EDIT IF <CR>
4221 IF(X22.EQ.0)GO TO 5517
IF(R2.NE.0)GO TO 5517
C BACKS UP WHEN IN EDIT MODE.
IF(JA.GT.0)GO TO 5518
IF(I.EQ.IX)GO TO 91
IF(CHNG.NE.0.AND.JA.LT.0)GO TO 5505
C CAN'T DO '-N' AND OTHER THINGS AFTER CHANGES IN EDIT MODE.
ZERO=X22+1
C '0' AFTER AN EDIT ENDS THE EDIT AND GETS NEXT ITEM FOR EDIT.
72 IF(X22.EQ.0)GO TO 55
IF(KED.EQ.0)REDIT=999.
320 IF(I.NE.IX)GO TO 172
ITEM=ITEM-1
C TO DELETE AN ITEM
73 X22=0
CHNG=0
C RESET CHANGE FLAG
CALL CLRCUR
CALL DPYNEW
IF(REDIT.EQ.999.)GO TO 428
IF(JA.EQ.55)GO TO 554
IF(JA.EQ.44)GO TO 44
428 IF(R2.EQ.0.OR.R2.GT.ITEM)GO TO 55
C DELETION IN EDIT MODE DOES NOT LEAVE MODE.
424 X22=R2
425 IF(X22.GT.ITEM)GO TO 73
C LEAVES EDIT MODE.
429 CALL BOXX
CC429 IX=I
CC MEDIT=PWDS(X22)
CC J=2
CC426 Y=RN(MEDIT)+J
CC CALL LOOP(0,Y,1,I,MEDIT,RN)
CC JJA=RN(I+1)
CC YED=Y-2
CC L=I+2
CC DO 422 K=1,11
CC IF(K.GT.YED)GO TO 423
CC RJJ(K)=RN(L+K)
CC GO TO 422
CC423 RJJ(K)=0
CC422 CONTINUE
CC RJJ2=RN(L)
CC IF(IGO.GT.0)GO TO 4231
C NO BOX WHEN IN GROUP EDIT ROUTINE
CC IBOX=I
CC RBOX=RJJ2
CC CALL BOX(IBOX,RBOX)
CC4231 ITEM=ITEM+1
CC ST2=WDS(ITEM)
GO TO 55
5517 IF(JA.EQ.0)GO TO 6221
5518 X=100-JA
IF(X)JA=JA/100
IF(JA.LE.2)GO TO 7221
CALL EQUAL(X)
CC IF(JA.LE.13)GO TO 324
CC JA=JA/10
C ADD 1000 TO PARAM TO MAKE EQUAL TO ANOTHER PARAM
CC X=R2-2.
CC RJJ(JA-2)=RJJ(X)
CC GO TO 6222
CC324 I1=JA-2
CC IF(X)GO TO 224
CC RJJ(I1)=R2
CC GO TO 6222
CC224 RJJ(I1)=RJJ(I1)+R2
GO TO 6222
178 IF(X22.EQ.0)GO TO 7555
C 'C' = COPY (IN OR OUT OF EDIT MODE) CR=CRESC.
CC IF(I2.EQ.IBLA)GO TO 883
IF(I2.NE.IBLA)GO TO 176
177 IF(CHNG.EQ.0)GO TO 5505
C CAN'T 'COPY' UNLESS CHANGES WERE MADE.
IOLD=0
GO TO 883
176 IF(R2.NE.0)GO TO 177
C IS THERE A NUMBER AFTER C
R2=1
C CN=CENTER, CH=AT HEAD, CT=AT TAIL, CX=EXIT FROM CENTERING MODE.
JA=13
IF(I2.EQ.IXX)R2=0
IF(I2.EQ.LHH)R2=-R2
IF(I2.EQ.IT)R2=-2
IF(I2.EQ.LBB)CB=6
IF(I2.EQ.LVV)CB=-1
C TYPE 'CB' FOR CENTER-BIG (BIG RANGE =6) ****** 'CV'=SET CURVE OF SLUR.
GO TO 6531
CC278 IF(X22.NE.0)GO TO 59
7555 IF(I2.EQ.IBLA)GO TO 7556
C NEXT FOR ME=MENO=81 MOLTO=90 CRESC.=70 MP=43 MF=50
RD=43
IF(I2.EQ.LFF)RD=50
IF(I2.EQ.LOH)RD=90
IF(I2.EQ.LEE)RD=81
IF(I2.EQ.IR)RD=70
GO TO 1442
7556 CALL MOVER
IF(R2.EQ.99)GO TO 59
C 99=BACKUP OUT OF MOVER ETC.
IGO=0
JFONT=0
C SO IT WON'T DO ALL FONT LOOKUPS.
8853 IF(JJ2)GO TO 5505
M=PWDS(JJ2)
I=PWDS(ITEM+1)
ITEM=JJ2-1
ST2=WDS(JJ2)
C SO IT DOESN'T HAVE TO GO THROUGH ALL ITEMS
GO TO 8852
420 REDIT=0
IF(I2.NE.IBLA)GO TO 320
C WE GET HERE WHEN TYPING 'ST' OR 'ED' WHEN ALREADY IN EDIT MODE.
IF(R2.EQ.0)GO TO 211
IF(CHNG.NE.0)GO TO 5505
C CATCH 'S'ET AFTER A CHANGE WAS MADE.
GO TO 320
C GO PAST HERE ONLY FOR 'A'LIGN
211 IF(KED.GE.0)RLINE=RJ3
RJ3=RLINE
GO TO 6222
C FOR '55' ALIGNING
7221 IF(X)GO TO 4223
CALL PARCH(JA,JJA,R2)
GO TO 6222
4223 RJJ2=R2+RJJ2
C ARRAYS NEED 2O LOCATIONS HERE.
C CHNG PARAMS WITH PAIRS OF NUMS.(EG. 2,122 4,13 5,-2 ETC.)
6222 CALL RJED
6221 CALL RJED2
C BELOW IS NOW IN 'LOOP.FAI'
CC6222 DO 1222 K=1,20,2
CC L=JQ(K)
CC IF(L.EQ.0)GO TO 6221
C '600 2' WILL ADD 2 TO PARAM 6. '3000 6' SETS P3=P6.
CC RD=RJQ(K+1)
CC X=L
CC IF(L.LT.100)GO TO 223
CC IF(L.LT.2000)GO TO 5223
CC X=L/1000
CC L=JQ(K+1)-2
CC RD=RJJ(L)
CC GO TO 2223
CC5223 X=L/100
CC IF(X.EQ.2)GO TO 1223
CC RD=RJJ(X-2)+RD
CC GO TO 2223
CC1223 RD=RJJ2+RD
CC223 IF(X.LE.2)GO TO 3223
CC2223 RJJ(X-2)=RD
CC GO TO 1222
CC3223 CALL PARCH(X,JJA,RD)
C NOW P1 CAN BE CHANGED IN EDIT MODE -- BE CAREFUL,,,,!!!!!!
CC1222 CONTINUE
C*** LOOP SET TO 11 (20 IN ARRAY!) ONLY 13 PARAMS POSSIBLE NOW.
CC6221 DO 5514 K=1,11
CC R2=RJJ(K)
CC RJQ(K)=R2
CC5514 JQ(K)=R2
CC R2=RJJ2
CC JA=JJA
CC ITEM=ITEM-1
CC IF(ITEM)ITEM=0
ST2=WDS(ITEM+1)
I=PWDS(ITEM+1)
IF(X22.NE.0)CHNG=-1
C SET CHANGE FLAG TO TRAP EDIT MODE ERRORS. (CLEARED AT 172)
CALL DPYNEW
60 J2=R2
IF(J2.LT.0)GO TO 5505
IF(J2.GT.7)GO TO 5505
C STOPS TYPO ERROR ON STAFF NUM. (<0, >7)
RSTJ2=RSTFAC(J2)
C* IF(JA.NE.2)GO TO 163
C* IF(R8.EQ.0)GO TO 163
C* IF(R8.EQ.-1)GO TO 163
C* IF(R8.EQ.-4)GO TO 163
C R8=0=AS IS; -1=WHOLE REST; >0=NUMBER OVER REST; -2=CENTERED
C R8=-3 = CENTERED REST (BUT NOT CHANGED TO WHOLE)
C R8=-4 = MEASURE REPEAT SIGN. =-5 = REPEAT SIGN CENTERED.
C* K=ITEM
C ITEM+1 IS CURRENT ITEM IN QUICK RUN-THROUGHS.
C* IF(X22.NE.0)K=X22-1
C* RD=1.75*RSTJ2
C* L=PWDS(K+2)
C* IF(RN(L+1).NE.4)GO TO 164
C GO ON IF NEXT ISN'T BAR LINE (CODE 4. NEXT FINDS OTHER LINES!!)
C* IF(RN(L+2).NE.R2)GO TO 164
C* RB=RN(L+3)
C* L=PWDS(K)
C CHECK PREV. AND NEXT ITEM. IF NOT BAR, DON'T TRY TO CENTER!
C* IF(RN(L+1).NE.4)GO TO 164
C* IF(RN(L+2).NE.R2)GO TO 164
C JUMP IF NOT ON SAME STAFF
C* RA=RN(L+3)
C* R3=RA+(RB-RA)/2-1.75*RSTJ2
C*164 IF(PLT.EQ.0)GO TO 160
C* RN(PWDS(K+1)+3)=R3
C ******* A DANGEROUS PLACE. KEEP TRACK OF THIS
C* GO TO 5541
163 IF(JA.EQ.16)GO TO 63
IF(PLT.NE.0)GO TO 5541
IF(JA.NE.8)GO TO 70
IF(R9.NE.1)GO TO 160
L=7
K='INST.'
C RJQ(7) IS R9
71 RA=RN(MEDIT+L+2)
CALL TYPCHR(RA,5)
CCCC TYPE 427,RA
CALL TYPCRLF
CALL TYPSTR('TYPE ')
CALL TYPCHR(K,5)
CALL TYPSTR(' NAME ')
CCC721 FORMAT(' TYPE ',A5,' NAME '$)
CCC TYPE 721,K
READ(IDEV,FA5)RD
CALL LO2UP(RD)
RJQ(L)=RD
IF(RD.NE.' ')GO TO 160
IF(RN(MEDIT).LT.L)RA=0
C RESTORES NAME IF THERE WAS ONE ALREADY. ELSE=0
RJQ(L)=RA
C WHEN P9=1 ASKS FOR ID NAME FOR THE STAFF (FOR PART EXTRACTOR)
GO TO 160
CF371 FORMAT(A5,A1,A3)
70 IF(JA.NE.11)GO TO 160
C ↑↑↑↑ WAS - TO 63
IF(J10.NE.1)GO TO 160
K='FILE'
L=8
C P10←1 GETS NAME OF BASIC DRAW FILE, PUTS IT IN P10 (NJR)
GO TO 71
C IF NO NAME ASKED FOR, IT TAKES LAST NAME GIVEN.(SOLVES SORT PROB?)
63 RD=R5
IF(RD.GE.100)RD=RD-100
C ADD 100 TO SZ TO MAKE TEXT APPEAR IN ALL SEPARATE PARTS OF ORCH. SCORE.
IF(J10.EQ.0)GO TO 162
L=ITEM
IF(X22.NE.0)L=X22-1
IF(J10.EQ.1)GO TO 263
C ↓↓↓↓ TEMP. FIX TO CNVT TEXT FORMAT TO NEW STYLE. "10 99"
IF(J10.NE.99)GO TO 863
X=PWDS(X22)+6
DO 563 L=X,X+2
RB=RN(L)
K=RB
C CHECKS TO SEE WHICH FORMAT
563 IF(K.NE.RB)GO TO 663
GO TO 57
663 DO 763 L=X,X+2
763 RN(L)=RN(L)*100.
GO TO 57
C NEXT FOR CENTERING TEXT. P10>1
863 RB=0
X=PWDS(L+1)
363 L=L+1
K=PWDS(L)
RB=RB+RN(K+9)
C ADD SPACE NEEDED
K=PWDS(L+1)
IF(RN(K+1).NE.16)GO TO 463
IF(RN(K).EQ.8)GO TO 363
C GO BACK IF MORE LETTERS TO COME
463 R3=R10-(RB-3.4)*RD*RSTJ2/2.
C +3.4 IS TO COMPENSATE FOR STARTING POS. BEING IN CENTER OF LET.
R10=0
IF(RN(X).EQ.8)RN(X+10)=0
RN(X+3)=R3
C THESE ARE NEEDED FOR ITEMS CENTERED DIRECTLY FROM 'WORDS'
GO TO 162
263 K=PWDS(L)
R3=AMOD(RN(K+5),100.)*RSTJ2*RN(K+9)+RN(K+3)
C AMOD BECAUSE P5+100 IS USED FOR PARTS PROGRAM.
R4=RN(K+4)
R5=RN(K+5)
R2=RN(K+2)
J2=R2
L=PWDS(L+1)
DO 361 JJA=3,5
361 RN(L+JJA)=RJQ(JJA-2)
RN(L+2)=R2
162 IF(PLT.NE.0)GO TO 5541
160 RJ3=R3
JJA=JA
IF(R8.NE.0)GO TO 161
IF(JA.EQ.1)R8=999.
C 999=0 FOR STEM EXTENSIONS.
C USES ONLY 10 PARAMETERS BEYOND JA, J2
161 CALL MSSLUP
IF(JA.NE.6)GO TO 1261
CX I DON'T THINK THIS NEXT IS NEEDED NOW. 9/78 IF(J13.EQ.0)GO TO 171
CX R2=X22
CX X22=0
CX R3=R13
CX J3=J13
CX R4=R11
C RESET HOMING RANGE (DEFAULT=3) WITH P11.
CX CALL CLRCUR
CX R13=0
C TYPE 13, n WITH BEAMS TO ADJUST IN RE. TO OTHER STAFF(LIKE OLD 'AD')
CX JA=19
CX GO TO 271
171 CALL HOMER
1261 IF(R13.EQ.0)GO TO 261
RD=R11
IF(CB.EQ.0)GO TO 2261
C *** CB = CENTER-BIG I.E. BIG RANGE FOR CENTERING -- 6 UNITS. (CAN VARY LATER??)
IF(RD.EQ.0)R11=CB
IF(JA.NE.5.OR.CB.GT.0)GO TO 2261
C *** CV = SET CURVE OF SLUR. (FOR USE AFTER SPACE CHANGES, ETC.)
R7=RCURVE(R3)
CC R7=0.9+(R6-R3)/25.+ABS(R4-R5)/10.
C SAME FORMULA AS FOUND IN SLURZ ROUTINE. FUNCTION CURVE IS IN LOOP
CC IF(R7)RB=-RB
CC DONE IN 'RCURVE'*** R7=RB
RJ7=R7
GO TO 3261
2261 CALL HOMER
3261 CB=0
R11=RD
C R11 GETS CHANGED IN 'HOMER'
CC IF(JA.EQ.2.AND.R9.NE.0)CALL RSTCEN
C RSTCEN IS FOR CENTERING WHOLE RESTS.
IF(JA.EQ.10)R3=R3+RSTJ2
IF(JA.NE.9)GO TO 261
IF(J5.GT.3)GO TO 261
CALL NOZERO(R6)
R3=R3+RSTJ2+2.*RSTJ2*R6
C ABOVE HELPS CENTER NUMBERS UNDER NOTES(BECAUSE R3 IS AT CENTR OF NUM)
C IF P13≠0 ANY ITEM WILL LINE UP WITH ANY OTHER ITEM. P13 IS RESET=0
C P13=-1 POSITIONS ITEM ABOVE OR BELOW NOTE, =-2 JUST BEYOND STEM.
C CODE 10 (NUMBERS) SPACED TO LEFT AS WELL AS CODE 9, P5=1,2,3 (FLAT,SHRP,NAT)
C **** FOR '0' EDITS ******
261 CALL LUP2
5541 IF(DP(J2).GE.0)GO TO 61
IF(JA.NE.8)GO TO 57
C NOW GET SIZE FACTOR, IF IT'S THERE. (NEEDED IN 'SCORE' SECTION.)
IF(R5.NE.0)RSTFAC(J2)=R5
GO TO 57
C*** 3/74 NEW DP SYSTEM
C WHAT ABOUT EDITS?*******
61 POS=STFF(J2)
RX3=R3
C SAVES IT IN RJQ(20) FOR OTHER ROUTINES.
J3=ROFF(RHORZ(R3))
C LINE IS DIVIDED INTO 200 POINTS.
CALL CENTX
C SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
R3=J3
IF(JA.LE.2)GO TO 11
551 GO TO(1,1,68,25,67, 625,116,125,11,69, 68,12),JA
GO TO (116,81,80),JA-15
C FOR 16,17,18 (WORDS, KSIG, METER)
IF(JA.EQ.99)GO TO 57
C FOR PART EXTRACTOR TRANSPOSER - KEY SIG=0
IF(JA.NE.33.AND.JA.NE.44)GO TO 222
JA=JA/11
C THIS IS TEMPORARY - TO READ PAGE TEMP. FILES.
GO TO 551
222 I=PWDS(ITEM+1)
GO TO 5505
C 44 1; JFONT=ONE DISPLAYS FONTS - THIS ALSO CATCHES SOME TYPOS
69 CALL MAKNUM(R5)
GO TO 57
68 CALL CLEFS
GO TO 57
67 CALL SLUR
GO TO 57
116 CALL ALPHA
GO TO 57
81 CALL KSIG
GO TO 57
80 CALL METER
GO TO 57
125 IF(R2.EQ.0)RMOV=R8
CALL STAFF
GO TO 57
CC625 IF(J10.LT.100)GO TO 1625
CC CALL BEAMX
CC GO TO 160
625 CALL BEAMX
CC625 CALL BMSTF
GO TO 57
C BEAMS, STAFF LINES ****
12 CALL CIRCLE
GO TO 57
25 CALL ITMSUB
C BAR LINES, ETC.
GO TO 57
C TO GET DISPLAY: 'G'; 'GM' ADDS TO DPY;
CC120 IF(X22.NE.0)GO TO 59
C GO BACK IF STILL IN EDIT MODE
120 J2=0
IF(I.EQ.1)GO TO 1220
L=NAME
X=EXT
IF(I2.EQ.IBLA)GO TO 222
J2=-1
I2=(I2-'0')/536870912
C TURN ASCII INTO INTEGER.
IF(I2.GT.9.OR.I2.LT.0)GO TO 1220
C VERT. STEPS PER INCH = 23.9 (CONSIDER STAFF SIZE FACTOR TOO)
R2=I2
J2=1
C 'GM'=GET MORE(BUT OLD OUTPUT NAME IS RESTORED AT 2207)
C 'Gn'=GET MORE AND PUT IT ON STAFF n AT POS. OF STAFF 0'S P8.
C ANYTHING AFTER 'G' BUT A NUMBER IS TAKEN AS 'GM'.
CCCC IF(I2.NE.IM)GO TO 222
CCCC J2=-1
1220 I1=-1
CALL NAMEXT(INP,NAME,EXT)
C NOW TYPE 'G NAME' OR 'GM NAME'
IF(NAME.NE.IBLA)GO TO 1221
1225 CALL TYPSTR(' NAME.EXT? ')
CCC1225 TYPE 21
READ(IDEV,89,END=3502)INP
CQQ ACCEPT 89,INP
C GO PUT A1'S INTO A5, ETC.
CALL NAMEXT(INP,NAME,EXT)
IF(NAME.EQ.IBLA)GO TO 2220
IF(NAME.NE.'99')GO TO 1221
C TYPE '99' TO BACK OUT OF 'SAVE'.
NAME=L
EXT=X
GO TO 5505
1221 IF(I1.NE.LESS)GO TO 1226
IDEV=5
GO TO 1225
1226 IF(LOOKX(NAME,EXT).EQ.0)GO TO 1225
C FUNC. LOOKD IS 'FAIL' PROG. TO CHECK ON LOOKUPS
2220 JA=-1
C -1 IS FOR 8852+3
2200 J=ITEM+1
IF(NAME.NE.IBLA)GO TO 2207
CALL GETEXT('TMP','DMD')
GO TO 2205
2207 CALL GETEXT(NAME,EXT)
2205 IF(J2.EQ.0)GO TO 2202
NAME=L
EXT=X
C ABOVE GETS BACK ORIGINAL NAME WITH 'GM' AND 'Gn'
2202 CALL EXTIN(RSTFAC,128)
CALL EXTIN(PWDS(J),JJ2)
CALL EXTIN(RN(I),IPOS)
ITEM=ITEM+JJ2-2
CCCC IF(J2)GO TO 2203
IF(J2)2203,3202,4202
CC IF(I2.EQ.IM)GO TO 2203
C J2=-1,1=GM *******'GET MORE' DOES NOT GET MOTIVE LIST OF NEW FILE.*******
3202 IF(LCNT.GT.1)CALL EXTIN(LIST,LCNT)
I=IPOS
IF(RSTF.EQ.0)GO TO 85
C (END OF V ARRAY)RSTF=-1 MEANS READ THE DPY BUFFER
CALL EXTIN(ST,4302)
CALL DPYNEW
GO TO 5505
4202 DO 5202 K=1,ITEM
IF(RN(PWDS(K)+1).NE.8)GO TO 5202
J3=PWDS(K)
IF(RN(J3+2).NE.0)GO TO 5202
R8=RN(J3+8)
C ASSUMES SPACE INFO IS IN P8. GET IT.
C NEXT FOR VERTICAL SPACING OF NEW STAFF TO BE READ.
R5=23.9/RSTFAC(0)
R3=.73*R2
C INCHES BETWEEN STAVES=.73
R4=(R8-R3)*R5
C R4=CHANGE FROM NORMAL POSITION FOR INCOMING STAFF.
GO TO 2203
5202 CONTINUE
C IF NO STAFF 0 WAS FOUND R4=0
R4=0
2203 M=I-1
DO 2204 K=J,J+JJ2-2
PWDS(K)=PWDS(K)+M
IF(J2.LE.0)GO TO 2204
C NEXT FOR GET-MORE AND PUT ON STAFF #R2
J3=PWDS(K)
RN(J3+2)=R2
IF(RN(J3+1).NE.8)GO TO 2204
RN(J3+4)=R4
C SET HEIGHT OF STAFF - DEPENDANT UPON P8 OF STAFF 0.
CCC IF(RN(J3).GE.6)RN(J3+8)=0
C ZERO SPACING PARAM IN UPPER STAVES.
2204 CONTINUE
GO TO 85
M=IX
C IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
C (J8) P8=1 OR 2 FOR 2-PASS PLOTS
C 1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
C RMOV HAS INCHES FROM P8 OF STAFF 0.
C R6=1 FOR NO MOVE AT END. R7=INCHES TO MOVE FOR NEW STAFF 0.
C RE. R7:DISTANCE IS MEASURED FROM BOTTOM LINE OF STANDARD POSITION
C OF STAFF 0 UP TO LOWEST!! POINT FOUND IN FOLLOWING FILE. THEN
C NEXT SHIFT IS AGAIN FROM STANDARD STF.0 TO NEXT FILE'S LOW POINT.
C MOVES PLOTTER UP IF P5=0.
C NEXT RUNS THROUGH DATA WITH NEW CHANGES.
6120 IF(M.GE.I)GO TO 7120
IF(IGO.EQ.0)GO TO 7121
C USE "Z" TO DO FIXUP WHEN LIST IS SCRAMBLED !?X@!ZQ
IF(M.EQ.PWDS(ITEM+1))GO TO 7121
K=ITEM+1
CALL TYPSTR(' FIXING ITEM ')
CALL TYPINT(K)
CALL TYPCRLF
CCCC TYPE 7122,K
CCC7122 FORMAT(' FIXING ITEM ',I3)
PWDS(K)=M
7121 CALL RUNTHR(M)
IF(EDQ.LE.0)GO TO 60
GO TO 5505
7120 M=1
IF(PLT.EQ.1)EDQ=-1
PLT=0
GO TO 5505
C ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
1 FORMAT(I,24F)
CCC56 FORMAT(/1XA5,' TYPE FOR ITEM #',I3,I,I6/)
CCC21 FORMAT(' NAME.EXT? '$)
END